perm filename COPYIT.LST[XX,LCS] blob
sn#205526 filedate 1976-03-12 generic text, type T, neo UTF8
COPYIT.F4 F40 V25 12-MAR-76 10:42 PAGE 1
00010 C***** COPYIT, UPDN, STFCH ****** (OUTLIM, GETPTS, MOVIT -ALL OLD)
06600
06700 SUBROUTINE COPYIT
1M BLOCK 0
06750 INTEGER PWDS
06800 COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
06900 COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
07000 1/PTR/PWDS(250),ITEM,LL,I,IX
07100 EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
07200 1,(R6,RJQ(4)),(N,RN(2500))
07300
07400 IM=ITEM
MOVE 02,ITEM
MOVEM 02,IM
07500 DO 1 K=1,IM
MOVEI 15,1
2M MOVEM 15,K
3M BLOCK 0
07600 L=PWDS(K)
MOVE 02,PWDS -1(15)
MOVEM 02,L
07700 IF(RTLINE(L))GO TO 1
JSA 16,RTLINE
ARG 00,L
JUMPL 00,1P
07800 IF(OUTLIM(L,3))GO TO 1
JSA 16,OUTLIM
ARG 00,L
ARG 00,CONST.
JUMPL 00,1P
07900 IF(R6.NE.0.AND.R6.NE.RN(L+1))GO TO 1
MOVE 02,R6
MOVE 03,L
CAMN 02,RN (3)
TDZA 02,2
SETO 02,0
COPYIT.F4 F40 V25 12-MAR-76 10:43 PAGE 2
MOVE 03,R6
CAIN 03,0
TDZA 03,3
SETO 03,0
AND 02,3
JUMPL 02,1P
08000 M=RN(L)+2
MOVSI 02,202400
MOVE 03,L
FADR 02,RN -1(3)
JSA 16,IFIX
ARG 00,2
MOVEM 00,M
08100 CALL LOOP(0,M,1,I,L,RN)
JSA 16,LOOP
ARG 00,CONST.+1
ARG 00,M
ARG 00,CONST.+2
ARG 00,I
ARG 00,L
ARG 02,RN
08200 ITEM=ITEM+1
AOS ITEM
08300 L=PWDS(ITEM)
MOVE 03,ITEM
MOVE 02,PWDS -1(3)
MOVEM 02,L
08400 RN(L+2)=R7
MOVE 02,L
MOVE 03,R7
MOVEM 03,RN +1(2)
08500 IF(JJ2)JJ2=ITEM
MOVE 02,JJ2
JUMPGE 02,4M
MOVE 02,ITEM
MOVEM 02,JJ2
4M BLOCK 0
08600 I=I+M+1
MOVEI 02,1
ADD 02,M
ADDM 02,I
08700 PWDS(ITEM+1)=I
COPYIT.F4 F40 V25 12-MAR-76 10:43 PAGE 3
MOVE 02,ITEM
MOVE 03,I
MOVEM 03,PWDS (2)
08800 1 CONTINUE
1P CAMGE 15,IM
AOJA 15,2M
08900 R2=R7
MOVE 02,R7
MOVEM 02,R2
09000 END
JRST 5M
COPYI% ARG 00,0
MOVEM 15,TEMP.
MOVEM 16,TEMP. +1
JRST 1M
5M MOVE 15,TEMP.
MOVE 16,TEMP. +1
JRA 16,0(16)
CONSTANTS
0 000000000003 1 000000000000 2 000000000001
COMMON
RN /XRN /+0 DONT /KJY /+0 JY /KJY /+1 S /POSI /+0 JJ2 /POSI /+10
P /POSI /+11 R2 /.COMM./+0 JA /.COMM./+1 CENTR /.COMM./+2 J2 /.COMM./+3
RJQ /.COMM./+4 RX6 /.COMM./+26 JR /.COMM./+27 L /.COMM./+30 RDIS /.COMM./+31
VY /.COMM./+32 JQ /.COMM./+33 PWDS /PTR /+0 ITEM /PTR /+372 LL /PTR /+373
I /PTR /+374 IX /PTR /+375 R4 /.COMM./+5 R5 /.COMM./+6 R7 /.COMM./+10
R6 /.COMM./+7 N /XRN /+4703
SUBPROGRAMS
RTLINE OUTLIM IFIX LOOP
SCALARS
COPYIT 110 IM 111 ITEM 372 K 112 L 30
R6 7 M 113 I 374 R7 10 JJ2 10
R2 0 DONT 0 JY 1 P 11 JA 1
CENTR 2 J2 3 RX6 26 JR 27 RDIS 31
VY 32 LL 373 IX 375 R4 5 R5 6
N 4703
COPYIT.F4 F40 V25 12-MAR-76 10:44 PAGE 4
ARRAYS
RN 0 S 0 RJQ 4 JQ 33 PWDS 0
COPYIT.F4 F40 V25 12-MAR-76 10:44 PAGE 5
09100 SUBROUTINE STFCH
1M BLOCK 0
09110 INTEGER PWDS
09200 COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
09300 COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
09400 1/PTR/PWDS(250),ITEM,LL,I,IX
09500 EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
09600 1,(R6,RJQ(4))
09700
09800 DO 1 K=1,ITEM
MOVEI 15,1
2M MOVEM 15,K
3M BLOCK 0
09900 L=PWDS(K)
MOVE 02,PWDS -1(15)
MOVEM 02,L
10000 IF(RTLINE(L))GO TO 1
JSA 16,RTLINE
ARG 00,L
JUMPL 00,1P
10100 IF(OUTLIM(L,3))GO TO 1
JSA 16,OUTLIM
ARG 00,L
ARG 00,CONST.
JUMPL 00,1P
10200 IF(RN(L+1).NE.R6.AND.R6.NE.0)GO TO 1
MOVE 02,R6
CAIN 02,0
TDZA 02,2
SETO 02,0
MOVE 03,R6
MOVE 04,L
CAMN 03,RN (4)
TDZA 03,3
SETO 03,0
AND 02,3
JUMPL 02,1P
10300 C DIDN'T MATCH THE CODE NUM.
COPYIT.F4 F40 V25 12-MAR-76 10:44 PAGE 6
10350 IF(JJ2)JJ2=K
MOVE 02,JJ2
JUMPGE 02,4M
MOVEM 15,JJ2
4M BLOCK 0
10400 RN(L+2)=R7
MOVE 02,L
MOVE 03,R7
MOVEM 03,RN +1(2)
10500 1 CONTINUE
1P CAMGE 15,ITEM
AOJA 15,2M
10600 END
JRST 5M
STFCH% ARG 00,0
MOVEM 15,TEMP.
MOVEM 16,TEMP. +1
JRST 1M
5M MOVE 15,TEMP.
MOVE 16,TEMP. +1
JRA 16,0(16)
CONSTANTS
0 000000000003
COMMON
RN /XRN /+0 DONT /KJY /+0 JY /KJY /+1 S /POSI /+0 JJ2 /POSI /+10
P /POSI /+11 R2 /.COMM./+0 JA /.COMM./+1 CENTR /.COMM./+2 J2 /.COMM./+3
RJQ /.COMM./+4 RX6 /.COMM./+26 JR /.COMM./+27 L /.COMM./+30 RDIS /.COMM./+31
VY /.COMM./+32 JQ /.COMM./+33 PWDS /PTR /+0 ITEM /PTR /+372 LL /PTR /+373
I /PTR /+374 IX /PTR /+375 R4 /.COMM./+5 R5 /.COMM./+6 R7 /.COMM./+10
R6 /.COMM./+7
SUBPROGRAMS
RTLINE OUTLIM
SCALARS
STFCH 52 K 53 ITEM 372 L 30 R6 7
JJ2 10 R7 10 DONT 0 JY 1 P 11
R2 0 JA 1 CENTR 2 J2 3 RX6 26
COPYIT.F4 F40 V25 12-MAR-76 10:44 PAGE 7
JR 27 RDIS 31 VY 32 LL 373 I 374
IX 375 R4 5 R5 6
ARRAYS
RN 0 S 0 RJQ 4 JQ 33 PWDS 0
COPYIT.F4 F40 V25 12-MAR-76 10:44 PAGE 8
10700
10800 SUBROUTINE UPDN(NST)
1M BLOCK 0
10880 INTEGER PWDS
10900 COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
11000 COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
11100 1/PTR/PWDS(250),ITEM,LL,I,IX
11200 EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
11300 1,(R6,RJQ(4))
11400
11500 DO 1 K=NST,ITEM
MOVE 15,NST
2M MOVEM 15,K
3M BLOCK 0
11600 L=PWDS(K)
MOVE 02,PWDS -1(15)
MOVEM 02,L
11700 IF(RTLINE(L))GO TO 1
JSA 16,RTLINE
ARG 00,L
JUMPL 00,1P
11800 RY=RN(L+1)
MOVE 03,L
MOVE 02,RN (3)
MOVEM 02,RY
11900 IF(RY.GT.16)GO TO 1
MOVSI 02,205400
CAMGE 02,RY
JRST 1P
12000 IF(RY.EQ.8)GO TO 1
MOVSI 02,204400
CAMN 02,RY
JRST 1P
12100 IF(RY.EQ.3)GO TO 1
MOVSI 02,202600
CAMN 02,RY
COPYIT.F4 F40 V25 12-MAR-76 10:44 PAGE 9
JRST 1P
12200 IF(RY.EQ.R6)GO TO 10
MOVE 02,RY
CAMN 02,R6
JRST 10P
12250 IF(R6.NE.0)GO TO 1
MOVE 02,R6
JUMPN 02,1P
12300 C DIDN'T MATCH THE CODE NUM.
12400 10 IF(RY.NE.4)GO TO 11
10P MOVSI 02,203400
CAME 02,RY
JRST 11P
12450 IF(RN(L).LT.3)GO TO 1
MOVSI 02,202600
MOVE 03,L
CAMLE 02,RN -1(3)
JRST 1P
12500 C A BAR LINE
12600 11 IF(OUTLIM(L,3))GO TO 2
11P JSA 16,OUTLIM
ARG 00,L
ARG 00,CONST.
JUMPL 00,2P
12650 RN(L+4)=RN(L+4)+R11
MOVE 02,R11
MOVE 03,L
FADRM 02,RN +3(3)
12675 IF(JJ2)JJ2=K
MOVE 02,JJ2
JUMPGE 02,4M
MOVE 02,K
MOVEM 02,JJ2
4M BLOCK 0
12700 2 IF(RY.LT.4)GO TO 1
2P MOVSI 02,203400
CAMLE 02,RY
JRST 1P
12800 IF(RY.GT.7)GO TO 1
COPYIT.F4 F40 V25 12-MAR-76 10:45 PAGE 10
MOVSI 02,203700
CAMGE 02,RY
JRST 1P
12900 IF(RY.EQ.7)GO TO 1
MOVSI 02,203700
CAMN 02,RY
JRST 1P
13000 C NO WIGGLE ON TRILL
13100 IF(RY.NE.4.)GO TO 12
MOVSI 02,203400
CAME 02,RY
JRST 12P
13150 IF(RN(L+5).EQ.50)GO TO 1
MOVSI 02,206620
MOVE 03,L
CAMN 02,RN +4(3)
JRST 1P
13200 C CRESC. OR BOX
13300 12 IF(OUTLIM(L,6))GO TO 1
12P JSA 16,OUTLIM
ARG 00,L
ARG 00,CONST.+1
JUMPL 00,1P
13350 RN(L+5)=RN(L+5)+R11
MOVE 02,R11
MOVE 03,L
FADRM 02,RN +4(3)
13360 IF(JJ2)JJ2=K
MOVE 02,JJ2
JUMPGE 02,5M
MOVE 02,K
MOVEM 02,JJ2
5M BLOCK 0
13400 1 CONTINUE
1P MOVE 15,K
CAMGE 15,ITEM
AOJA 15,2M
13500 END
JRST 6M
COPYIT.F4 F40 V25 12-MAR-76 10:45 PAGE 11
UPDN% ARG 00,0
MOVEM 15,TEMP.
MOVEM 16,TEMP. +1
MOVEI 00,TEMP. +2
PUSH 00,@0(16)
JRST 1M
6M MOVE 15,TEMP.
MOVE 16,TEMP. +1
JRA 16,1(16)
CONSTANTS
0 000000000003 1 000000000006
GLOBAL DUMMIES
NST 127
COMMON
RN /XRN /+0 DONT /KJY /+0 JY /KJY /+1 S /POSI /+0 JJ2 /POSI /+10
P /POSI /+11 R2 /.COMM./+0 JA /.COMM./+1 CENTR /.COMM./+2 J2 /.COMM./+3
RJQ /.COMM./+4 RX6 /.COMM./+26 JR /.COMM./+27 L /.COMM./+30 RDIS /.COMM./+31
VY /.COMM./+32 JQ /.COMM./+33 PWDS /PTR /+0 ITEM /PTR /+372 LL /PTR /+373
I /PTR /+374 IX /PTR /+375 R4 /.COMM./+5 R5 /.COMM./+6 R11 /.COMM./+14
R6 /.COMM./+7
SUBPROGRAMS
RTLINE OUTLIM
SCALARS
UPDN 130 K 131 NST 127 ITEM 372 L 30
RY 132 R6 7 R11 14 JJ2 10 DONT 0
JY 1 P 11 R2 0 JA 1 CENTR 2
J2 3 RX6 26 JR 27 RDIS 31 VY 32
LL 373 I 374 IX 375 R4 5 R5 6
ARRAYS
RN 0 S 0 RJQ 4 JQ 33 PWDS 0
COPYIT.F4 F40 V25 12-MAR-76 10:45 PAGE 12
13600
15000 CF SUBROUTINE GETPTS
15100 CF DIMENSION N(500),NP(500)
15200 CF COMMON/XRN/RN(4000) /KJY/ K,J
15300 CF COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
15400 CF 1/PTR/PWDS(250),ITEM,LL,I,IX
15500 CF EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
15600 CF 1,(R6,RJQ(4)),(N,RN(2500)),(NP,RN(3000))
15700 CF J=0
15800 CF K=0
15900 CF DO 1 M=1,ITEM
16000 CF L=PWDS(M)
16100 CF IF(RTLINE(L))GO TO 1
16200 CF RY=RN(L+1)
16300 CF IF(R6.LE.0)GO TO 9
16400 C CHECK CODE NUM
16500 CF IF(R6.NE.RY)GO TO 1
16600 CF9 IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
16700 C IN LIMITS?
16800 CF IF(JJ2)JJ2=M **** ALSO AT 6,8 AND 5 ***
16900 CF J=J+1
17000 CF N(J)=L+3
17100 CF K=K+1
17200 CF NP(K)=L
17300 C FOR USE IN JUSTIFY ROUTINE
COPYIT.F4 F40 V25 12-MAR-76 10:46 PAGE 13
17400 CF2 IF(RY.LT.4)GO TO 1
17500 CF IF(RY.GT.7)GO TO 1
17600 C TWO-ENDED ITEM?
17700 CF RZ=RN(L)
17800 C WD CNT
17900 CF GO TO(4,5,6,7),IFIX(RY)-3
18000 CF4 IF(RZ.GT.2)GO TO 5
18100 CF GO TO 1
18200 CF7 IF(RZ.GT.4)GO TO 5
18300 CF GO TO 1
18400 CF6 IF(RZ.LT.8)GO TO 8
18500 CF IF(RN(L+10).LT.30)GO TO 8
18600 CF IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
18700 CF J=J+1
18800 CF N(J)=L+8
18900 CF IF(RZ.LT.7)GO TO 5
19000 CF IF(OUTLIM(R4,R5,RN(L+9)))GO TO 5
19100 CF J=J+1
19200 CF N(J)=L+9
19300 CF5 IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
19400 CF J=J+1
19500 CF N(J)=L+6
19600 CF1 CONTINUE
19700 CF END
19800
COPYIT.F4 F40 V25 12-MAR-76 10:46 PAGE 14
19900 CF FUNCTION OUTLIM(A,B,C)
20000 CF OUTLIM=-1
20100 CF IF(C.LT.A)RETURN
20200 CF IF(C.GT.B)RETURN
20300 CF OUTLIM=0
20400 CF END
20500 CF SUBROUTINE MOVIT
20600 CF DIMENSION N(500)
20700 CF COMMON/XRN/RN(4000) /KJY/ DONT,J
20800 CF COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
20900 CF EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R9,RJQ(7))
21000 CF 1,(R6,RJQ(4)),(N,RN(2500)),(R8,RJQ(6))
21100 CF RDIS=(R9-R8)/(R5-R4)
21200 CF DO 1 K=1,J
21300 CF L=N(K)
21400 CF RA=RN(L)
21500 CF IF(OUTLIM(R4,R5,RA))GO TO 1
21600 CF IF(R9.NE.0)RA=(RA-R4)*RDIS
21700 CF RN(L)=R8+RA
21800 CF1 CONTINUE
21900 CF END